#!/usr/bin/perl -c

package PIPL::File::Lock;
use 5.006;
our $VERSION = '0.01';

=head1 NAME

PIPL::File::Lock - Handle file locking

=head1 SYNOPSIS

  use PIPL::File::Lock;
  $lock = new PIPL::File::Lock file=>'/etc/pi/main.yml';
  $lock->lock;    # lock the file
  $lock->unlock;  # unlock the file

=head1 DESCRIPTION

This class maintains file's locking mechanism.  There are two operations:
lock and unlock.  If the locking or unlocking operation fails, the exception
is thrown.

=cut


use strict;

use base 'PIPL::Class::Base';


use PIPL::System::Config;
use PIPL::System::Env;
use PIPL::System::Path;

use Exception::Base
    'Exception::Runtime'        => { isa => 'Exception::Base' },
    'Exception::UndefinedValue' => { isa => 'Exception::Runtime' },
    'Exception::IO'             => { isa => 'Exception::System' },
    'Exception::File'           => { isa => 'Exception::IO' },
    'Exception::Lock'           => { isa => 'Exception::File' };

use Fcntl;
use File::Spec;


# List of class fields (name => {is=>ro|rw, default=>value})
use constant FIELDS => {
    file          => { is => 'rw' },
    max_tries     => { is => 'rw', default => 5 },
    lock_file     => { is => 'ro' },
    tmp_lock_file => { is => 'ro' },
    locked        => { is => 'ro' },
};


# Lock the configuration file
sub lock {
    my $self = shift;

    # The alghoritm:
    #
    #  1. open tmp file
    #  2. link to lock file; try few times if lock already exist
    #  3. write to tmp file if it was all right
    #  4. unlink tmp file

    return if $self->{locked};

    throw Exception::UndefinedValue
          message => 'Undefined file',
          field => 'file'
        unless defined $self->{file};

    $self->{lock_file} = $self->{file} . '.lock';
    $self->{tmp_lock_file} = $self->{lock_file} . ".$$." . time;

    open my ($fh), '>', $self->{tmp_lock_file}
        or throw Exception::Lock
                 message => "Cannot create temporary lock file $self->{tmp_lock_file}",
                 operation => 'lock';

    try Exception::Base eval {
        TRY: {

            for (1 .. $self->{max_tries}) {
                # Intercept "File exists" error
                try Exception::Base eval {
                    link $self->{tmp_lock_file}, $self->{lock_file}
                        or throw Exception::Lock
                                 message => "Cannot create lock file $self->{lock_file}",
                                 operation => 'lock';
                };

                if (catch Exception::File my $e) {
                    # Rethrow if it wasn't "file exists" error
                    throw $e unless with $e errname => 'EEXIST';
                }
                else {
                    # No exception: no tries again
                    last TRY;
                }

                sleep 1;
            }

            # Still locked
            local $!;  # reset $ERRNO
            throw Exception::Lock
                  message => "Another application might be running; remove $self->{lock_file} if not",
                  operation => 'lock';

        }  # end TRY
    };

    my $e = catch Exception::File;

    if (not defined $e) {
        print $fh $$
            or throw Exception::Lock
            message => "Cannot write to $self->{lock_file}",
            operation => 'lock';
    }

    close $fh;

    unlink $self->{tmp_lock_file}
        or throw Exception::Lock
                 message => "Cannot remove temporary lock file $self->{tmp_lock_file}",
                 operation => 'lock';

    throw $e if (defined $e);

    return $self->{locked} = 1;
}


# Unlock the configuration file
sub unlock {
    my $self = shift;

    return unless $self->{locked};

    throw Exception::UndefinedValue
          message => 'Undefined file',
          field => 'file'
        unless defined $self->{file};

    throw Exception::UndefinedValue
          message => 'Undefined lock file',
          field => 'lock_file'
        unless defined $self->{lock_file};

    unlink $self->{lock_file}
        or throw Exception::Lock
           message => "Cannot remove lock file $self->{lock_file}",
           operation => 'unlock';

    $self->{locked} = undef;

    return 1;
}


# Clean up the lock file
sub DESTROY {
    my $self = shift;
    unlink $self->{tmp_lock_file} if defined $self->{tmp_lock_file} and -f $self->{tmp_lock_file};
    $self->unlock if $self->{locked};
}


1;


=head1 BASE CLASSES

=over 2

=item *

L<PIPL::Class::Base>

=back

=head1 FIELDS

=over

=item file (rw)

Contains the name for locked file.

=item max_tries (rw, default: 5)

Contains the maximum number of tries (1 try per second) if the file is
already locked.  After that, there will be thrown an exception if the file
still is already locked.

=item lock_file (ro)

Contains the name for lock file.  It should be the name for locked file with
B<.lock> suffix.

=item tmp_lock_file (ro)

Contains the name for temporary lock file.  It should be unique and it is
immediately removed after lock file is created.

=item locked (ro)

Contains the actual status of lock file.  If the configuration file is
locked, the attribute is B<1>.  It is B<undef> otherwise.

=back

=head1 CONSTRUCTORS

=over

=item new

Creates the lock object for the given I<file>.

=back

=head1 METHODS

=over

=item lock

Locks the file.  Returns B<1> if the file is locked and B<undef> if the file
was already locked.  It throws an exception if there was problems.

=item unlock

Unlocks the file.  Returns B<1> if the file is unlocked and B<undef> if the
file was already unlocked.  It throws an exception if there was problems.

=back

=head1 SEE ALSO

L<Exception::Base>, L<Exception::System>.

=head1 AUTHORS

Piotr Roszatycki E<lt>dexter@debian.orgE<gt>

=head1 COPYRIGHT

Copyright 2006-2007 by Piotr Roszatycki E<lt>dexter@debian.orgE<gt>.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

See L<http://www.perl.com/perl/misc/Artistic.html>
